/*-------------------<-- Start of Description-->---------------------\ | Output a SAS dataset to R; | |---------------------<-- End of Description-->----------------------| |--------------------------------------------------------------------| |------------<-- Start of Files or Arguments Needed-->---------------| | Argument: | | data: the data file you want to output to R; | | default is the syslast; | | var: the variable list you want to output; | | file: the output file path; | | default is to create a dat file under R directory; | | header: you want to add a file header to the output file | |------------<-- Start of Files or Arguments Needed-->---------------| |--------------------------------------------------------------------| |------------------<-- Start of Files Created-->---------------------| | Example: %outr(data = &syslast, var = pt evtstatus days; | | Usage: outr(data = &syslast, var =, where=, header = Y, | | file = C:\Duo\Rsdata\Rdata\ud.dat); | \-------------------<-- End of Files Created-->---------------------*/ %macro outr/parmbuff; /*--------------------------------------------\ | Copy Right: Duo Zhou; | | Created: 10-14-2002 9:49pm; | \--------------------------------------------*/ %local data indata outfile var where file header; proc format ; value na ( default = 15 ) ., .A = 'NA'; value $na (default = 200) ' ' = 'NA'; run; %let data=; %let indata=; %let outfile=; %let var=; %let where=; %let file=; %let header=; %let syspbuff=%sysfunc(translate(%quote(%substr(%quote(%trim(%quote(%left(%quote(&syspbuff))))), 2, %eval(%length(%trim(%quote(%left(%quote(&syspbuff)))))-2))), %str(%'), %str(%"))); %let _outrrx_=%sysfunc(rxparse($(1))); %let _xoutrpos_=0; %let _xoutrlen_=0; %let _xoutroldstr_=; %let _xoutrnewstr_=; %do %while( %sysfunc(rxmatch(&_outrrx_, %quote(&syspbuff))) ); %syscall rxsubstr(_outrrx_, syspbuff, _xoutrpos_, _xoutrlen_); %let _xoutroldstr_=%quote(%substr(%quote(&syspbuff), &_xoutrpos_, &_xoutrlen_)); %let _xoutrnewstr_=%quote(%sysfunc(translate(%quote(&_xoutroldstr_), À, %quote(%(), Á, %quote(%)), ´, %quote(,), ®, %quote( )))); %let syspbuff=%sysfunc(tranwrd(%quote(&syspbuff), %quote(&_xoutroldstr_), %quote(&_xoutrnewstr_))); %let _xoutrpos_=0; %let _xoutrlen_=0; %let _xoutroldstr_=; %let _xoutrnewstr_=; %end; %let _outrnewstr_=&syspbuff; %local _xoutrvarcnt_ _xoutrvar_; %let _xoutrvarcnt_=0; %do %while(%length(%qscan(%nrbquote(&_outrnewstr_), %eval(&_xoutrvarcnt_+1), %nrbquote(,)))); %let _xoutrvarcnt_=%eval(&_xoutrvarcnt_+1); %let _xoutrvar_=%nrbquote(%qscan(%nrbquote(&_outrnewstr_), &_xoutrvarcnt_, %nrbquote(,))); %let _xoutrvar_=%sysfunc(translate(%quote(&_xoutrvar_), '(', 'À', ')', 'Á', ',', '´', ' ', '®')); %let _xoutrx2_=%trim(%left(%qscan(%quote(&_xoutrvar_), 1, %str(=)))); %let _xoutrx3_=%substr(%quote(&_xoutrvar_), %eval(%index(%quote(&_xoutrvar_),%str(=))+1), %eval(%length(&_xoutrvar_)-%index(%quote(&_xoutrvar_),%str(=)))); %if (not %index(%BQUOTE(%trim(%BQUOTE(%left(%BQUOTE(&_xoutrvar_))))), %str(=))) %then %do; %if (%index(%BQUOTE(%trim(%BQUOTE(%left(%BQUOTE(&_xoutrx2_))))), %str(%()) eq 1) and (%index(%BQUOTE(%trim(%BQUOTE(%left(%BQUOTE(%sysfunc(reverse(&_xoutrx2_))))))), %str(%))) eq 1) %then %let _xoutrx3_=%substr(%quote(%trim(%quote(%left(%quote(&_xoutrx2_))))), 2, %eval(%length(%trim(%quote(%left(%quote(&_xoutrx2_)))))-2)); %if (%quote(&_xoutrvarcnt_) = %quote(1)) %then %let data=&_xoutrx3_; %else %if (%quote(&_xoutrvarcnt_) = %quote(2)) %then %let var=&_xoutrx3_; %else %if (%quote(&_xoutrvarcnt_) = %quote(3)) %then %let where=&_xoutrx3_; %else %if (%quote(&_xoutrvarcnt_) = %quote(4)) %then %let file=&_xoutrx3_; %else %if (%quote(&_xoutrvarcnt_) = %quote(5)) %then %let header=&_xoutrx3_; %end; %else %if (%index(%BQUOTE(%trim(%BQUOTE(%left(%BQUOTE(&_xoutrx3_))))), %str(%()) eq 1) and (%index(%BQUOTE(%trim(%BQUOTE(%left(%BQUOTE(%sysfunc(reverse(&_xoutrx3_))))))), %str(%))) eq 1) and (%index(%nrbquote(upcase(%nrbquote(%sysfunc(compress(%nrbquote(&_xoutrx2_)))))), WHERE=) le 1) %then %let &_xoutrx2_=%substr(%quote(%trim(%quote(%left(%quote(&_xoutrx3_))))), 2, %eval(%length(%trim(%quote(%left(%quote(&_xoutrx3_)))))-2)); %else %let &_xoutrx2_=&_xoutrx3_; %end; %if (%quote(&indata) ne) and (%quote(&data) eq) %then %let data=&indata; %if (%quote(&header) eq) %then %let header=Y; %if (%quote(&outfile) ne) and (%quote(&file) eq) %then %let file=&outfile; %else %if (%quote(&outfile) eq) and (%quote(&file) eq) %then %let file=C:\Duo\Rsdata\Rdata\ud.dat; %if (%quote(&file) ne) %then %do; %let file=%sysfunc(compress(%quote(%sysfunc(compress(%quote(%trim(%quote(%left(%quote(&file))))), '"'))), "'")); %let file=%sysfunc(translate(%quote(&file), %str(\), %str(/))); %if (not %index(%quote(%sysfunc(reverse(%quote(%upcase(%trim(%quote(%left(%quote(&file))))))))),%quote(TAD.))) %then %let file=%trim(%quote(%left(%quote(&file)))).dat; %if (not %sysfunc(indexw(%upcase(%trim(%quote(%left(%quote(&file))))), %quote(PRINT)))) and (%index(%quote(&file), %str(\))) %then %let file="&file"; %else %if (not %index(%quote(&file), %str(\))) %then %let file="C:\Duo\Rsdata\Rdata\%trim(%quote(%left(%quote(&file))))"; %else %let file=print; %end; %let _vnames_=; %if (%quote(&var)=) %then %do; %let _outrcharvar_=; %do _vari_=1 %to %nvars(&data); %if (&_vari_=1) %then %let _vnames_="%trim(%left(%varname(&data, &_vari_)))"; %else %let _vnames_=%trim(%left(&_vnames_)) +1 "%trim(%left(%varname(&data, &_vari_)))"; %if (%vartype(&data, &_vari_) ne 1) %then %do; %let _outrcharvar_=&_outrcharvar_ %varname(&data, &_vari_); %end; %end; data _null_ ; %if (%quote(&_outrcharvar_) ne) %then %do; length &_outrcharvar_ $200.; format &_outrcharvar_ $200.; %end; set &data %if (%quote(&where) ne) %then (where=(&where));; file &file; %if %upcase(%substr(&header.,1,1))=Y %then %do; if _n_ eq 1 then put &_vnames_; %end;; %do _vari_=1 %to %nvars(&data); %if (%vartype(&data, &_vari_)=1) %then %do; length _char_%trim(%left(%varname(&data, &_vari_))) $200.; %if (&_vari_=1) %then %do; if missing(%varname(&data, &_vari_)) then do; _char_%trim(%left(%varname(&data, &_vari_)))=trimn(left(put(%varname(&data, &_vari_), na.))); put #_n_ _n_ _char_%trim(%left(%varname(&data, &_vari_))) @@; end; else put #_n_ _n_ %varname(&data, &_vari_) @@; %end; %else %do; if missing(%varname(&data, &_vari_)) then do; _char_%trim(%left(%varname(&data, &_vari_)))=trimn(left(put(%varname(&data, &_vari_), na.))); put _char_%trim(%left(%varname(&data, &_vari_))) @@; end; else put %varname(&data, &_vari_) @@; %end; %end; %else %do; length %varname(&data, &_vari_) $200.; if missing(%varname(&data, &_vari_)) then %varname(&data, &_vari_)='"'||'NA'||'"'; else %varname(&data, &_vari_)='"'||trimn(left(%varname(&data, &_vari_)))||'"'; %if (&_vari_=1) %then %do; put #_n_ _n_ %varname(&data, &_vari_) @@; %end; %else %do; put %varname(&data, &_vari_) @@; %end; %end; %end; run; %end; %else %do; %let _outrcharvar_=; %do _vari_=1 %to %words(&var, dlm=%nrstr((), )); %let _dummyvar_=%qscan(%quote(&var), &_vari_, %nrstr((), )); %if (%varnum(&data, &_dummyvar_) ge 1) %then %do; %if (&_vari_=1) %then %let _vnames_="%trim(%left(&_dummyvar_))"; %else %let _vnames_=%trim(%left(&_vnames_)) +1 "%trim(%left(&_dummyvar_))"; %if (%vartype(&data, &_dummyvar_) ne 1) %then %do; %let _outrcharvar_=&_outrcharvar_ %trim(%left(&_dummyvar_)); %end; %end; %else %put ==> Alert! Data set %upcase(%trim(%left(&data))) does not contain variable %upcase(%trim(%left(&_dummyvar_)))!; %end; data _null_ ; %if (%quote(&_outrcharvar_) ne) %then %do; length &_outrcharvar_ $200.; format &_outrcharvar_ $200.; %end; set &data %if (%quote(&where) ne) %then (where=(&where));; file &file; %if %upcase(%substr(&header.,1,1))=Y %then %do; if _n_ eq 1 then put &_vnames_; %end;; %do _vari_=1 %to %words(%quote(&var), dlm=%nrstr((), )); %let _ivar_=%qscan(%quote(&var), &_vari_, %nrstr((), )); %if (%varnum(&data, &_ivar_) ge 1) %then %do; %if (%vartype(&data, &_ivar_)=1) %then %do; length _char_%trim(%left(&_ivar_)) $200.; %if (&_vari_=1) %then %do; if missing(&_ivar_) then do; _char_%trim(%left(&_ivar_))=trimn(left(put(&_ivar_, na.))); put #_n_ _n_ _char_%trim(%left(&_ivar_)) @@; end; else put #_n_ _n_ &_ivar_ @@; %end; %else %do; if missing(&_ivar_) then do; _char_%trim(%left(&_ivar_))=trimn(left(put(&_ivar_, na.))); put _char_%trim(%left(&_ivar_)) @@; end; else put &_ivar_ @@; %end; %end; %else %do; if missing(&_ivar_) then &_ivar_='NA'; %if (&_vari_=1) %then %do; put #_n_ _n_ &_ivar_ @@; %end; %else %do; put &_ivar_ @@; %end; %end; %end; %end; run; %end; %mend outr;